MODULE Glotz;
(* v1.20 (c) 10.1992 Copyright, %-Angabe, 0C-Terminierung in LZH-Namen
 * v1.15 (c)	1.1992 Martin Bauer; SFX/LZH-Routine zuverl„ssiger gemacht
 * v1.10 (c)	5.1990 Christian Sprenger .AR, .LIB
 * v1.00 (c)	2.1990 Christian Sprenger
 *
 * listet Inhalt von .AR, .ARC, .LIB, .LZH, .SFX und .ZOO
 * - f�rs Desktop zum Anmelden
 *
 * geschrieben in H„nisch Modula-2 [Version 5.10]
 *)

IMPORT appl,inf,mouse,select,vwk;
IMPORT HMExt,Str;
FROM Cmd IMPORT ArgNum,ArgRead;
FROM GEMDOS IMPORT Fopen,Fseek,Fread,Fclose,Fdatime,tDostime,Cconout,
				ReadOnly,WriteOnly,Update, SAbsolute,SRelative,SFromEnd;
FROM Paths IMPORT GetFile,GetExt;
FROM TimeDate IMPORT tTime,tDate,CardToTime,CardToDate;
FROM SYSTEM IMPORT ADDRESS,ADR,TSIZE;

CONST
	VER = '1.20';


TYPE
	Short = RECORD CASE:BOOLEAN OF
	|  TRUE: hi,lo: CHAR
	| FALSE:		sc: SHORTCARD
	END END;

	Long = RECORD CASE:SHORTINT OF
	|0: c0,c1,c2,c3: CHAR
	|1: 				 lc: LONGCARD
	|2: 				 li: LONGINT
	END END;

	tFile = RECORD
		name: ARRAY[0..13] OF CHAR;
		size: LONGINT;
		date,time: SHORTCARD;
		len: LONGINT;
	END;

CONST
	LISTMAX = 999;

VAR
	list: ARRAY[0..LISTMAX+3] OF tFile;

(*--------------------------------- ARC -----------------------------------*)

TYPE
	tArcHdr = RECORD
		rsvd1: CHAR;
		flag : CHAR;								 (*falls 0, ung�ltig*)
		fname: ARRAY[0..11] OF CHAR;
		rsvd2: CHAR;
		size0,size1,size2,size3: CHAR;
		date0,date1: CHAR;
		time0,time1: CHAR;
		crc0,crc1: CHAR;
		len0,len1,len2,len3: CHAR;
	END;

PROCEDURE ScanARC(VAR fname: STRING): SHORTCARD;
VAR
	f: SHORTINT;
	h: tArcHdr;
	i: SHORTINT;
	j: SHORTINT;
	pos: Long;
	flen: LONGINT;
BEGIN
	f := Fopen(fname,ReadOnly);
	IF f<0 THEN RETURN 0 END;
	flen := Fseek(0,f,SFromEnd);
	pos.li := Fseek(0,f,SAbsolute);
	j := -1;
	REPEAT
		INC(j);
		IF Fread(f,TSIZE(tArcHdr),ADR(h))#TSIZE(tArcHdr) THEN RETURN 0 END;
		WITH list[j] DO
			WITH h DO
				FOR i:=0 TO 11 DO name[i] := fname[i] END; name[12] := 0C;
				Short(date).lo := date0;
				Short(date).hi := date1;
				Short(time).lo := time0;
				Short(time).hi := time1;
				Long(size).c3 := size0;
				Long(size).c2 := size1;
				Long(size).c1 := size2;
				Long(size).c0 := size3;
				Long(len).c3 := len0;
				Long(len).c2 := len1;
				Long(len).c1 := len2;
				Long(len).c0 := len3;
				pos.c3 := size0;
				pos.c2 := size1;
				pos.c1 := size2;
				pos.c0 := size3;
			END
		END
	UNTIL (h.flag=0C) (*ung�ltiger Eintrag*)
		 OR (Fseek(pos.li-1,f,SRelative) >= flen-TSIZE(tArcHdr))
		 OR (j=LISTMAX-1);
	FileDT(f,j);
	VOID(Fclose(f));
	IF h.flag#0C THEN (*g�ltiger Eintrag*) INC(j) END;
	RETURN j
END ScanARC;

(*------------------------------ AR / LIB ---------------------------------*)

TYPE
	tArHdr = RECORD
		FName 	 : ARRAY[0..43] OF CHAR;
		Time,Date: SHORTCARD;
		Len 		 : ARRAY[0..11] OF CHAR;
	END;

PROCEDURE ScanAR(VAR fname: STRING): SHORTCARD;
VAR
	f: SHORTINT;
	h: tArHdr;
	i: SHORTINT;
	j: SHORTINT;
	magic: LONGCARD;
	flen,d: LONGINT;
BEGIN
	f := Fopen(fname,ReadOnly);
	IF f<0 THEN RETURN 0 END;
	flen := Fseek(0,f,SFromEnd);
	d := Fseek(0,f,SAbsolute);
	IF (4#Fread(f,4,ADR(magic))) OR (magic#213C6172H)
	OR (4#Fread(f,4,ADR(magic))) OR (magic#63683E0AH) THEN RETURN 0 END;
	j := -1;
	REPEAT
		INC(j);
		IF Fread(f,TSIZE(tArHdr),ADR(h))#TSIZE(tArHdr) THEN RETURN 0 END;
		WITH list[j] DO
			WITH h DO
				FOR i:=0 TO 11 DO name[i] := FName[i] END; name[12] := 0C;
				date := Date;
				time := Time;
				len := 0; i := 0;
				WHILE ('0'<=Len[i]) & (Len[i]<='9') DO
					len := 10*len + INT(ORD(Len[i]) - 60B); INC(i)
				END;
				size := len;
				d := len; IF ODD(d) THEN INC(d) END
			END
		END
	UNTIL (Fseek(d,f,SRelative) >= flen-TSIZE(tArHdr))
		 OR (j=LISTMAX-1);
	FileDT(f,j);
	VOID(Fclose(f));
	RETURN j + 1
END ScanAR;

(*------------------------------- LHZ & SFX ---------------------------------*)

CONST
	cSizeOfHeaderMax=  255+2;  (* headsiz ist maximal 255 +2 f�r ChkSum *)
TYPE
	tLHArcHdr = RECORD
		headsiz: CHAR;	(* headsiz+2 ist die Position des ersten Datenbytes *)
		headchk: CHAR;	(* Checksum des Headers *)
		mth1, mth2,mth3,mth4,mth5: CHAR;	(*Methode: "-lh0-", "-lh1-",... *)
		packsiz0,packsiz1,packsiz2,packsiz3: CHAR;	(*Jetzige Gr”áe*)
		orgsiz0,orgsiz1,orgsiz2,orgsiz3: CHAR;			(*Original-Gr”áe*)
		time0,time1: CHAR;
		date0,date1: CHAR;
		bits0,bits1: CHAR;
		fnlen: CHAR;										(*L„nge des Filenamens*)
		fname: ARRAY[0..255] OF CHAR; 	(*Grožz�gig dimensioniert*)
		(* Nach dem Filenamen kommt noch die CRC-Checksum der reinen Daten. *)
		(* Im erweiterten Headerformat folgen anschliežend ein paar Bytes, *)
		(* deren Verwendungszweck noch nicht gekl„rt ist. *)
	END;

PROCEDURE ScanLZH(SFX: BOOLEAN; (*selfextracting *.SFX?*)
						VAR fname: STRING): SHORTCARD;
VAR
	f: SHORTINT;
	h: tLHArcHdr;
	path: ARRAY[0..255] OF CHAR;
	i: SHORTINT;
	j: SHORTINT;
	pos: Long;
	fpos: LONGINT;
	blockBytesRead: LONGINT;	(* Block entspricht einem File im Archiv *)
	restOfBlock: LONGINT;

	PROCEDURE HeaderOK( VAR h:tLHArcHdr ):BOOLEAN;
	TYPE
		tByte 	=[0..255];
		tpByte	=POINTER TO tByte;
	VAR
		(*$R+*)p: tpByte;
		(*$R+*)q: tpByte;
		(*$R+*)hcs: tByte;
	BEGIN
		hcs := tByte(h.headchk);
		p := ADR(h.mth1);
		q := ADR(h.mth1) + tByte(h.headsiz);
		WHILE ADDRESS(p) < ADDRESS(q) DO
			hcs := hcs-p^;
			INC(p)
		END;
		RETURN hcs=0;
	END HeaderOK;

BEGIN
	f := Fopen(fname,ReadOnly);
	IF f<0 THEN RETURN 0 END;
	IF SFX THEN
		pos.li := Fseek(30,f,SAbsolute);
		IF Fread(f,4,ADR(pos))#4 THEN VOID(Fclose(f)); RETURN 0 END;
		IF pos.li#53465800H THEN RETURN 0 END; (*Kennung "SFX"*)
		IF Fread(f,4,ADR(pos))#4 THEN VOID(Fclose(f)); RETURN 0 END;
		pos.li := Fseek(pos.li,f,SAbsolute);
	ELSE pos.li := Fseek(0,f,SAbsolute) END;
	j := -1;
	LOOP
		INC(j);
		blockBytesRead := Fread(f,cSizeOfHeaderMax,ADR(h));
		IF (blockBytesRead < (VAL(LONGINT,ORD(h.headsiz))+2))
				OR ~HeaderOK( h ) THEN
			EXIT
		END;
		WITH list[j] DO
			WITH h DO
				Long(size).c3 := packsiz0;
				Long(size).c2 := packsiz1;
				Long(size).c1 := packsiz2;
				Long(size).c0 := packsiz3;
				Long(len).c3 := orgsiz0;
				Long(len).c2 := orgsiz1;
				Long(len).c1 := orgsiz2;
				Long(len).c0 := orgsiz3;
				Short(date).lo := date0;
				Short(date).hi := date1;
				Short(time).lo := time0;
				Short(time).hi := time1;

				Str.CopyN(fname,path,VAL(SHORTINT,fnlen));
				path[VAL(SHORTINT,fnlen)+1] := 0C;
				GetFile(path,name);
				restOfBlock := (VAL(LONGINT,ORD(h.headsiz))+2)+size - blockBytesRead;
				fpos:=Fseek(0,f,SRelative);
				IF (Fseek(restOfBlock,f,SRelative) # fpos+restOfBlock)
						OR (j=LISTMAX-1) THEN
					EXIT
				END;
			END;
		END;
	END;
	FileDT(f,j);
	VOID(Fclose(f));
	RETURN j
END ScanLZH;

(*--------------------------------- ZOO -----------------------------------*)

TYPE
	tZooCtrl = RECORD
		memo: LONGCARD; (*DCA7C4FDH*)
		rsvd: Short;
		next: Long; 		(*Zeiger auf n„chsten tZooCtrl*)
		data: Long; 		(*Zeiger auf komprimierte Datei*)
	END;
	tZooHdr = RECORD
		date0,date1: CHAR;
		time0,time1: CHAR;
		crc1,crc2: CHAR;
		len0,len1,len2,len3: CHAR;		 (*Original-Gr”áe*)
		size0,size1,size2,size3: CHAR; (*Jetzige Gr”áe*)
		nix3: ARRAY[0..9] OF CHAR;
		fname: ARRAY[0..12] OF CHAR;
	END;

PROCEDURE ScanZOO(VAR fname: STRING): SHORTINT;
VAR
	f: SHORTINT;
	h: tZooHdr;
	c: tZooCtrl;
	i: SHORTINT;
	j: SHORTINT;
	pos: Long;
(*	flen: LONGINT;*)
	ch: CHAR;
BEGIN
	f := Fopen(fname,ReadOnly);
	IF f<0 THEN RETURN 0 END;
	IF (Fread(f,4,ADR(pos))#4) OR (pos.li#5A4F4F20H) THEN RETURN 0 END; (*"ZOO"*)
(*	flen := Fseek(0,f,SFromEnd);*)
	IF (Fseek(24,f,SAbsolute)#24) OR (Fread(f,4,ADR(pos))#4) THEN RETURN 0 END;
	ch := pos.c0; pos.c0 := pos.c3; pos.c3 := ch;
	ch := pos.c1; pos.c1 := pos.c2; pos.c2 := ch;
	IF pos.li#Fseek(pos.li,f,SAbsolute) THEN RETURN 0 END;
	j := -1;
	REPEAT
		INC(j);
		IF Fread(f,TSIZE(tZooCtrl),ADR(c))#TSIZE(tZooCtrl) THEN RETURN 0 END;
		pos.c3 := c.next.c0;
		pos.c2 := c.next.c1;
		pos.c1 := c.next.c2;
		pos.c0 := c.next.c3;
		IF Fread(f,TSIZE(tZooHdr),ADR(h))#TSIZE(tZooHdr) THEN RETURN 0 END;
		WITH list[j] DO
			WITH h DO
				Long(size).c3 := size0;
				Long(size).c2 := size1;
				Long(size).c1 := size2;
				Long(size).c0 := size3;
				Long(len).c3 := len0;
				Long(len).c2 := len1;
				Long(len).c1 := len2;
				Long(len).c0 := len3;
				Short(date).lo := date0;
				Short(date).hi := date1;
				Short(time).lo := time0;
				Short(time).hi := time1;
				GetFile(fname,name);
			END
		END;
	UNTIL (list[j].name[0]<=' ') (*ung�ltiger Eintrag*)
		 OR (Fseek(pos.li,f,SAbsolute)#pos.li) OR (j=LISTMAX-1);
	FileDT(f,j);
	VOID(Fclose(f));
	IF list[j].name[0]>' ' THEN INC(j) END; (*g�ltiger Eintrag*)
	RETURN j
END ScanZOO;

(*-------------------------------------------------------------------------*)

PROCEDURE FileDT(fd,n: SHORTINT);
VAR
	dt: tDostime;
BEGIN
	Fdatime(dt,fd,FALSE);
	WITH list[n+1] DO
		date := dt.date;
		time := dt.time;
	END;
END FileDT;

(*$E+*)
PROCEDURE Line(i: SHORTINT; VAR res: STRING; usr: ADDRESS);
VAR
	j,k: SHORTINT;
	s: ARRAY[0..61] OF CHAR;
	str: ARRAY[0..9] OF CHAR;
	d: tDate;
	t: tTime;
BEGIN
	(*s := 'xxxxxxxx.xxx  ssssssss  llllllll  tt.mm.jj  hh.mm.ss';*)
	IF (i>n) OR (i=n-1) THEN s := ''
	ELSIF i=n-3 THEN
		s := '------------  --------  --------                    ';
	ELSIF i=n THEN
		s := 'v'+VER+'  ½1989-92 Christian Sprenger, Modular Systems GbR    ';
	ELSE
		WITH list[i] DO
			j := 0;
			WHILE (name[j]#'.') & (name[j]#0C) DO
				s[j] := name[j]; INC(j)
			END;
			FOR k:=j TO 8 DO s[k] := ' ' END; k := 9;
			IF name[j]#0C THEN INC(j);
				WHILE name[j]#0C DO
					s[k] := name[j]; INC(j); INC(k)
				END
			END;
			FOR j:=k TO 13 DO s[j] := ' ' END;
			s[14] := 0C;
			s := FORM(s,len:8,'  ',size:8,'  ');
			CardToDate(date,d);
			CardToTime(time,t);
			s := FORM(s,
				d.day:2, '.',d.month:2:10:'0','.',d.year MOD 100:2:10:'0','  ',
				t.hour:2,':',t.min:2:10:'0',	':',t.sec:2:10:'0',' ',
				100 - size*100 DIV len:3,'%');
		END;
	END;
	Str.Assign(res,s);
END Line;
(*$E-*)

VAR
	fname: ARRAY[0..79] OF CHAR;
	ext: ARRAY[0..3] OF CHAR;
	i,n: SHORTINT;
	s: ARRAY[0..79] OF CHAR;
BEGIN
	IF (appl.init()>=0) & vwk.init() THEN
		inf.init;
		IF ArgNum()>1 THEN
			n := 0;
			ArgRead(1,fname); GetExt(fname,ext);
			IF		Str.Compare(ext,'ARC')=0 THEN n := ScanARC(fname)
			ELSIF (Str.Compare(ext,'AR')=0)
				 OR (Str.Compare(ext,HMExt.Lib)=0)	THEN n := ScanAR(fname)
			ELSIF (Str.Compare(ext,'LZH')=0)
				 OR (Str.Compare(ext,'SFX')=0) THEN n := ScanLZH(ext[0]='S',fname)
			ELSIF Str.Compare(ext,'ZOO')=0 THEN n := ScanZOO(fname)
			END;
			IF n>0 THEN
				INC(n,3);
				WITH list[n-2] DO
					(* date, time sind gesetzt *)
					name := FORM('Gesamt: .',n-3:3);
					size := 0;
					len := 0;
					FOR i:=0 TO n-3 DO
						INC(size,list[i].size);
						INC(len,list[i].len);
					END
				END;
				mouse.arrow;
				i := select.do(TRUE,fname,n+1,57,Line,NIL,-1)
			ELSE
				Cconout(7C)
			END
		END
	END;
	vwk.exit;
	appl.exit;
END Glotz.
		
	
	